;;union currently requires options given to it, other an error "apply to non-list #f" occurs.
;;Todo: in create-inferior-package, forward build output.

(define-module (pkill9 utils)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix build-system trivial)
  #:use-module (guix inferior) ;; create-inferior-package
  #:use-module (guix channels) ;; create-inferior-package
  #:use-module (guix utils) ;; create-inferior-package
  #:export (union
            package-output->package
            create-bash-script
            create-inferior-package))

(define* (union name packages #:key options)
  (computed-file name
                 (with-imported-modules `((guix build union))
                                        #~(begin
                                            (use-modules (guix build union))
                                            (union-build #$output '#$packages)))
                 #:options options))

(define (package-output->package original-package package-output)
  (package
   (name (string-append (package-name original-package) "-" package-output))
   (version (package-version original-package))
   (source #f)
   (build-system trivial-build-system)
   (inputs
    `(("package" ,original-package ,package-output)))
   (arguments
    `(#:modules ((guix build utils))
      #:builder
      (begin
        (use-modules (guix build utils))
        (let* ((out (assoc-ref %outputs "out"))
               (original-package (assoc-ref %build-inputs "package")))
          (symlink original-package out)))))
   (home-page #f)
   (synopsis (string-append "Output " package-output
                            " of package: " (package-name original-package)))
   (description synopsis)
   (license (package-license original-package))))

(define* (executable-mixed-text-file name #:rest text)
  "Return an object representing store file NAME containing TEXT.  TEXT is a
sequence of strings and file-like objects, as in:

  (mixed-text-file \"profile\"
                   \"export PATH=\" coreutils \"/bin:\" grep \"/bin\")

This is the declarative counterpart of 'text-file*'. The resulting file is made executable."
  (define build
    (gexp (call-with-output-file (ungexp output "out")
            (lambda (port)
              (display (string-append (ungexp-splicing text)) port)
              (chmod (ungexp output "out") #o755)))))

  (computed-file name build))


(define* (executable-plain-file name text)
  "Return an object representing store file NAME containing TEXT.  TEXT is a
a string.

This is equivalent to plain-file, but the file is executable."
  (define build
    (gexp (call-with-output-file (ungexp output "out")
            (lambda (port)
              (display (ungexp text) port)
              (chmod (ungexp output "out") #o755)))))

  (computed-file name build))

(define* (create-bash-script script-name script-text paths-to-executables #:optional paths-to-arbitrary-files)
  ;;Create a bash script with executable permission
  ;;
  ;;all commands will have variables with their names pointing to the store path, so the bash script must use for example $mkdir instead of mkdir.
  ;;
  ;;paths-to-executables consists of a list of lists, which are composed of (<package-object> "/subdirectory/" "executable")
  ;; for example, (list (list coreutils "/bin/" "mkdir") (list grep "/bin/ "grep"))
  ;; However, if only two list items exist, then assume that the first is a store path direct to the executable, and the second is the variable name
  ;;
  ;; Paths-to-other-files consists of a list of lists, which are composed of (<package-object> "/path/to/file" "variable-name")
  ;; Maybe instead make a function that takes these, idk
  (let* ((executables-paths-header-lines
          (map
           (lambda (path)
             (if (> (length path) 2)
                 ;;If more than two list items
                 (list
                  (list-ref path 2) ;; Variable name
                  "="
                  (list-ref path 0) ;; Package object (executable-mixed-text-file converts to store path)
                  (list-ref path 1) ;; Subdirectory
                  (list-ref path 2) ;; Executable
                  "\n")
                 ;;Else
                 (list
                  (list-ref path 1) ;; Variable name
                  "="
                  (list-ref path 0) ;; Executable
                  "\n")))
           paths-to-executables))
         (arbitrary-paths-header-lines
          (if paths-to-arbitrary-files
              (map
               (lambda (path)
                 (list
                  (list-ref path 2) ;;Variable name
                  "="
                  (list-ref path 0) ;; Package object (executable-mixed-text-file converts to store path)
                  (list-ref path 1) ;; Subpath to file
                  "\n"
                  ))
               paths-to-arbitrary-files)
              (list)))
         (smooshed-header-lines (append (apply append executables-paths-header-lines)
                                        (apply append arbitrary-paths-header-lines)))
         )
    (apply executable-mixed-text-file (append (list script-name)
                                              (list "#!" (@ (gnu packages bash) bash) "/bin/bash" "\n\n")
                                              smooshed-header-lines
                                              (list "\n\n")
                                              (list script-text)))
    ))

(define* (create-inferior-package #:key
                                  guix-commit
                                  package-code-to-evaluate)
  (let* ((inferior-package (@@ (guix inferior) inferior-package)) ;; Localise private function
         (%inferior (inferior-for-channels
                     (list (channel
                            (name 'guix)
                            (url "https://git.savannah.gnu.org/git/guix.git")
                            (commit guix-commit)))))
         (pkg-info
          (inferior-eval
           `(begin
              (let* ((new-package ,package-code-to-evaluate)
                     (new-package-id (object-address new-package)))
                (hashv-set! %package-table new-package-id new-package) ;; Add the new package's object-address (assigned to id) to the inferior's %package-table
                `(,(package-name new-package)
                  ,(package-version new-package)
                  ,new-package-id)));; Return the package info for use with (inferior-package)
           %inferior)))
    (inferior-package %inferior
                      (list-ref pkg-info 0)
                      (list-ref pkg-info 1)
                      (list-ref pkg-info 2)))) ;; Return the inferior-package
